perm filename TANGLX.POS[WEB,ALS] blob
sn#621849 filedate 1981-11-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (* Note: This listing is for information only and not for compilation.
C00007 00003 (*17*)
C00017 00004 (*53*)
C00024 00005 (*70*)
C00034 00006 (*87*)
C00040 00007 (*99*)
C00048 00008 (*110*)
C00059 00009 (*128*)
C00067 00010 (*139*)
C00075 ENDMK
C⊗;
(* Note: This listing is for information only and not for compilation.
Liberties were taken to get it into form so that PFORM could be used,
involving the removal of most of the compiler directives.*)
(*2*)(*4*)
(*$C-,A+,D-*)
PROGRAM tangle(input,output,pool,tty);
LABEL 9999;
CONST
(*7*)
bufsize=100;
maxbytes=30000;
maxtoks=65535;
maxnames=4000;
maxtexts=2000;
hashsize=353;
longestname=300;
linelength=72;
outbufsize=144;
stacksize=50;
maxidlength=12;
unambiglengt=7;
TYPE
(*11*)
asciifile=FILE OF char;
asciicode=0..127;
(*26*)
eightbits=0..255;
sixteenbits=0..65535;
(*28*)
namepointer=0..maxnames;
(*31*)
textpointer=0..maxtexts;
(*65*)
outputstate=RECORD
endfield:sixteenbits;
bytefield:sixteenbits;
namefield:namepointer;
replfield:textpointer;
END;
VAR
(*12*)
pool:asciifile;
(*14*)
buffer:ARRAY[0..bufsize]OF asciicode;
(*16*)
phaseone:boolean;
(*27*)
bytemem:PACKED ARRAY[0..maxbytes]OF asciicode;
tokmem:PACKED ARRAY[0..maxtoks]OF eightbits;
bytestart:ARRAY[0..maxnames]OF sixteenbits;
tokstart:ARRAY[0..maxtexts]OF sixteenbits;
link:ARRAY[0..maxnames]OF sixteenbits;
ilk:ARRAY[0..maxnames] OF sixteenbits;
equiv:ARRAY[0..maxnames]OF sixteenbits;
textlink:ARRAY[0..maxtexts]OF sixteenbits;
(*29*)
nameptr:namepointer;
stringptr:namepointer;
byteptr:0..maxbytes;
(*32*)
textptr:textpointer;
tokptr:0..maxtoks;
maxtokptr:0..maxtoks;
(*37*)idfirst:0..bufsize;
idloc:0..bufsize;
doublechars:0..bufsize;
hash,chophash:ARRAY[0..hashsize]OF sixteenbits;
choppedid:ARRAY[0..unambiglengt]OF asciicode;
(*52*)
module:ARRAY[0..longestname]OF asciicode;
(*57*)
lastunnamed:textpointer;
(*66*)
curstate:
outputstate;
stack:ARRAY[1..stacksize]OF outputstate;
stackptr:0..stacksize;
(*68*)
bracelevel:eightbits;
(*72*)
curval:integer;
(*80*)
outbuf:ARRAY[0..outbufsize]OF asciicode;
outptr:0..outbufsize;
breakptr:0..outbufsize;
(*81*)
outstate:eightbits;
outval,outapp:integer;
outsign:asciicode;
(*86*)
outcontrib:ARRAY[1..linelength]OF asciicode;
(*108*)
page:sixteenbits;
line:sixteenbits;
limit:0..bufsize;
loc:0..bufsize;
inputhasende:boolean;
(*116*)
curmodule:namepointer;
(*127*)
nextcontrol:eightbits;
(*134*)
currepltext:
textpointer;
(*140*)
modulecount:0..12287;
(*148*)
debug troubleshoot:boolean;
ddt:sixteenbits;
dd:sixteenbits;
(*17*)
PROCEDURE debughelp;
FORWARD;
(*18*)
PROCEDURE error;
VAR
(*19*)
k,l:0..bufsize;
(*21*)
j:0..outbufsize;
BEGIN
IF phaseone THEN
(*20*)
BEGIN writeln(tty,'. (P.',page:0,',L.',line:0,')');
IF loc>=limit THEN l:=limit
ELSE l:=loc;
FOR k:=1 TO l DO
IF buffer[k-1]=9 THEN
write(tty,' ')
ELSE write(tty,chr(buffer[k-1]));
writeln(tty,'');
FOR k:=1 TO l DO write(tty,' ');
FOR k:=l+1 TO limit DO
write(tty,chr(buffer[k-1]));
write(tty,' ');
END
ELSE
(*22*)
BEGIN writeln(tty,'. (L.',line:0,')');
FOR j:=1 TO outptr DO write(tty,chr(outbuf[j-1]));
write(tty,'...');
END;
debughelp;
END;
(*23*)
PROCEDURE quit;
BEGIN
GOTO 9999;
END;
PROCEDURE initialize;
VAR
(*38*)
h:0..hashsize;
BEGIN
(*13*)
rewrite(pool,'','/O');
IF NOT eof(pool)THEN BEGIN writeln(tty);
write(tty,'! COULDN''T OPEN THE POOL FILE.');
quit;
END;
(*30*)
nameptr:=1;
stringptr:=
128;
byteptr:=1;
bytestart[0]:=1;
bytestart[1]:=1;
(*33*)
tokptr:=1;
textptr:=1;
tokstart[0]:=1;
tokstart[1]:=1;
(*35*)
ilk[0]:=0;
equiv[0]:=0;
(*39*)
FOR h:=0 TO hashsize-1 DO
BEGIN
hash[h]:=0;
chophash[h]:=0;
END;
(*58*)
lastunnamed:=0;
textlink[0]:=0;
(*123*)
module[0]:=32;
(*149*)
troubleshoot:=true;
ddt:=9999;
END;
(*10*)
FUNCTION openinput:boolean;
BEGIN
reset(input,'','/E/I/O');
openinput:=eof(input);
END;
(*15*)
FUNCTION inputln:boolean;
BEGIN
readln;
IF eof(input)THEN inputln:=false
ELSE
BEGIN
limit:=0;
buffer[0]:=ord(input↑);
IF buffer[0]<>12 THEN
WHILE buffer[limit]<>13 DO
IF limit=bufsize-1 THEN
BEGIN
buffer[limit]:=13;
writeln(tty);
write(tty,'! INPUT LINE TOO LONG');
error;
END
ELSE
BEGIN
limit:=limit+1;
get(input);
IF eof(input)THEN buffer[limit]:=13
ELSE buffer[limit]:=ord(input↑);
END;
inputln:=true;
END;
END;
(*36*)
PROCEDURE printid(p:namepointer);
VAR
k:0..maxbytes;
BEGIN
IF p>=nameptr THEN write(tty,'IMPOSSIBLE')
ELSE FOR k:=bytestart[p] TO bytestart[p+1]-1 DO
write(tty,chr(bytemem[k]));
END;
(*40*)
FUNCTION idlookup(t:eightbits):namepointer;
LABEL 31,32;
VAR
c:eightbits;
i:0..bufsize;
h:0..hashsize;
k:0..maxbytes;
l:0..bufsize;
p,q:namepointer;
s:0..unambiglengt;
BEGIN
l:=idloc-idfirst;
(*41*)
h:=buffer[idfirst];
i:=idfirst+1;
WHILE i<idloc DO BEGIN h:=(h+h+buffer[i])MOD hashsize;
i:=i+1;
END;
(*42*)
p:=hash[h];
WHILE p<>0 DO
BEGIN
IF bytestart[p+1]-bytestart[p]=l THEN
(*43*)
BEGIN
i:=idfirst;
k:=bytestart[p];
WHILE(i<idloc)AND(buffer[i]=bytemem[k]) DO
BEGIN
i:=i+1;
k:=k+1;
END;
IF i=idloc THEN GOTO 31;
END;
p:=link[p];
END;
p:=nameptr;
link[p]:=hash[h];
hash[h]:=p;
31:;
IF(p=nameptr)OR(t<>0)THEN
(*44*)
BEGIN
IF((p<>nameptr)AND(t<>0)
AND(ilk[p]=0))OR((p=nameptr)AND(t=0)
AND(buffer[idfirst]<>34))THEN
(*45*)
BEGIN
i:=idfirst;
s:=0;
h:=0;
WHILE (i<idloc) AND(s<unambiglengt)DO
BEGIN
IF buffer[i]<>24 THEN
BEGIN
IF buffer[i]>=97 THEN choppedid[s]:=buffer[i]-32
ELSE choppedid[s]:=buffer[i];
h:=(h+h+choppedid[s])MOD hashsize;
s:=s+1;
END;
i:=i+1;
END;
choppedid[s]:=0;
END;
IF p<>nameptr THEN
(*46*)
BEGIN
IF ilk[p]=0 THEN
BEGIN
writeln(tty);
write(tty,'! THIS IDENTIFIER HAS ALREADY APPEARED');
error;
(*47*)
q:=chophash[h];
IF q=p THEN chophash[h]:=equiv[p]
ELSE
BEGIN
WHILE equiv[q]<>p DO q:=equiv[q];
equiv[q]:=equiv[p];
END;
END
ELSE
BEGIN
writeln(tty);
write(tty,'! THIS IDENTIFIER WAS DEFINED BEFORE');
error;
END;
ilk[p]:=t;
END
ELSE
(*48*)
BEGIN
IF(t=0)AND(buffer[idfirst]<>34)THEN
(*49*)
BEGIN q:=chophash[h];
WHILE q<>0 DO
BEGIN
(*50*)
BEGIN
k:=bytestart[q];
s:=0;
WHILE(k<bytestart[q+1])AND(s<unambiglengt)DO
BEGIN
c:=bytemem[k];
IF c<>24 THEN
BEGIN
IF c>=97 THEN c:=c-32;
IF choppedid[s]<>c THEN GOTO 32;
s:=s+1;
END;
k:=k+1;
END;
IF(k=bytestart[q+1])AND(choppedid[s]<>0)THEN GOTO 32;
writeln(tty);
write(tty,'! IDENTIFIER CONFLICT WITH ');
FOR k:=bytestart[q]TO bytestart[q+1]-1 DO
write(tty,chr(bytemem[k]));
error;
q:=0;
32:
END;
q:=equiv[q];
END;
equiv[p]:=chophash[h];
chophash[h]:=p;
END;
IF byteptr+l>maxbytes THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','BYTE MEMORY',' CAPACITY EXCEEDED');
error;
quit;
END;
IF nameptr=maxnames THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','NAME',' CAPACITY EXCEEDED');
error;
quit;
END;
i:=idfirst;
k:=byteptr;
WHILE i<idloc DO
BEGIN
bytemem[k]:=buffer[i];
k:=k+1;
i:=i+1;
END;
byteptr:=k;
nameptr:=nameptr+1;
bytestart[nameptr]:=k;
IF buffer[idfirst]<>34 THEN ilk[p]:=t
ELSE
(*51*)
BEGIN
ilk[p]:=1;
IF l-doublechars=2 THEN equiv[p]:=buffer[idfirst+1]+32768
ELSE
BEGIN
equiv[p]:=stringptr+32768;
stringptr:=stringptr+1;
write(pool,chr(31+l-doublechars));
i:=idfirst+1;
WHILE i<idloc DO
BEGIN
write(pool,chr(buffer[i]));
IF(buffer[i]=34)OR(buffer[i]=64)THEN i:=i+2
ELSE i:=i+1;
END;
END;
END;
END;
END;
idlookup:=p;
END;
(*53*)
FUNCTION modlookup(l:sixteenbits):namepointer;
LABEL 31;
VAR
c:(less,equal,greater,prefix,extension);
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
BEGIN
c:=greater;
q:=0;
p:=ilk[0];
WHILE p<>0 DO
BEGIN
(*55*)
k:=bytestart[p];
c:=equal;
j:=1;
WHILE(k<bytestart[p+1])AND(j<=l)
AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1;
j:=j+1;
END;
IF k=bytestart[p+1] THEN
IF j>l THEN c:=equal
ELSE c:=extension
ELSE IF j>l THEN c:=prefix
ELSE IF module[j]<bytemem[k]THEN c:=less
ELSE c:=greater;
q:=p;
IF c=less THEN p:=link[q]
ELSE IF c=greater THEN p:=ilk[q]
ELSE GOTO 31;
END;
(*54*)
IF byteptr+l>maxbytes THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','BYTE MEMORY',' CAPACITY EXCEEDED');
error;
quit;
END;
IF nameptr=maxnames THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','NAME',' CAPACITY EXCEEDED');
error;
quit;
END;
p:=nameptr;
IF c=less THEN link[q]:=p
ELSE ilk[q]:=p;
link[p]:=0;
ilk[p]:=0;
c:=equal;
FOR j:=1 TO l DO bytemem[byteptr+j-1]:=module[j];
byteptr:=byteptr+l;
nameptr:=nameptr+1;
bytestart[nameptr]:=byteptr;
31:
IF c<>equal THEN
BEGIN
writeln(tty);
write(tty,'! INCOMPATIBLE MODULE NAMES');
error;
p:=0;
END;
modlookup:=p;
END;
(*56*)
FUNCTION prefixlookup(l:sixteenbits):namepointer;
LABEL 31;
VAR
c:(less,equal,greater,prefix,extension);
count:0..maxnames;
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
r:namepointer;
BEGIN
q:=0;
p:=ilk[0];
count:=0;
r:=0;
WHILE p<>0 DO
BEGIN
(*55*)
k:=bytestart[p];
c:=equal;
j:=1;
WHILE (k<bytestart[p+1])AND(j<=l)
AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1;
j:=j+1;
END;
IF k=bytestart[p+1]THEN
IF j>l THEN c:=equal
ELSE c:=extension
ELSE IF j>l THEN c:=prefix
ELSE IF module[j]<bytemem[k]THEN c:=less
ELSE c:=greater;
IF c=less THEN p:=link[p]
ELSE IF c=greater THEN p:=ilk[p]
ELSE
BEGIN
r:=p;
count:=count+1;
q:=ilk[p];
p:=link[p];
END;
IF p=0 THEN
BEGIN
p:=q;
q:=0;
END;
END;
IF count<>1 THEN
IF count=0 THEN
BEGIN writeln(tty);
write(tty,'! NAME DOES NOT MATCH');
error;
END
ELSE
BEGIN
writeln(tty);
write(tty,'! AMBIGUOUS PREFIX');
error;
END;
prefixlookup:=r;
END;
(*60*)
PROCEDURE storetwobyte(x:sixteenbits);
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=x DIV 256;
tokmem[tokptr+1]:=x MOD 256;
tokptr:=tokptr+2;
END;
(*61*)
PROCEDURE printrepl(p:textpointer);
VAR k:0..maxtoks;
a:sixteenbits;
BEGIN
IF p>=textptr THEN write(tty,'BAD')
ELSE
BEGIN
k:=tokstart[p];
WHILE k<tokstart[p+1]DO
BEGIN
a:=tokmem[k];
IF a>=128 THEN
(*62*)
BEGIN
k:=k+1;
IF a<168 THEN
BEGIN
a:=(a-128)*256+tokmem[k];
printid(a);
IF bytemem[bytestart[a]]=34 THEN write(tty,'"')
ELSE write(tty,' ');
END
ELSE IF a<208 THEN
BEGIN
write(tty,'@<');
printid((a-168)*256+tokmem[k]);
write(tty,'@>');
END
ELSE
BEGIN
a:=(a-208)*256+tokmem[k];
write(tty,'@(*',a:0,'@',chr(126));
END;
END
ELSE
(*63*)
CASE a OF
9:write(tty,'@(*');
10:write(tty,'@',chr(126));
12:write(tty,'@''');
13:write(tty,'#');
64:write(tty,'@@');
OTHERS:write(tty,chr(a))
END;
k:=k+1;
END;
END;
END;
(*70*)
PROCEDURE pushlevel(p:namepointer);
BEGIN
IF stackptr=stacksize THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','STACK',' CAPACITY EXCEEDED');error;
quit;
END
ELSE
BEGIN
stack[stackptr]:=curstate;
stackptr:=stackptr+1;
curstate.namefield:=p;
curstate.replfield:=equiv[p];
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+1];
END;
END;
(*71*)
PROCEDURE poplevel;
LABEL 10;
BEGIN
IF textlink[curstate.replfield]=0 THEN
BEGIN
IF ilk[curstate.namefield]=3 THEN
(*77*)
BEGIN
IF tokptr>maxtokptr THEN maxtokptr:=tokptr;
nameptr:=nameptr-1;
textptr:=textptr-1;
tokptr:=tokstart[textptr];
byteptr:=byteptr-1;
END;
END
ELSE IF textlink[curstate.replfield]<maxtexts THEN
BEGIN
curstate.replfield:=textlink[curstate.replfield];
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+1];
GOTO 10;
END;
stackptr:=stackptr-1;
IF stackptr>0 THEN curstate:=stack[stackptr];
10:
END;
(*73*)
FUNCTION getoutput:sixteenbits;
LABEL 20,30;
VAR
a:sixteenbits;
b:eightbits;
bal:sixteenbits;
BEGIN
20:
IF stackptr=0 THEN a:=0
ELSE
BEGIN
IF curstate.bytefield=curstate.endfield THEN
BEGIN
poplevel;
GOTO 20;
END;
a:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
IF a<128 THEN
BEGIN
IF a=13 THEN
(*78*)
BEGIN
pushlevel(nameptr-1);
GOTO 20;
END;
END
ELSE
BEGIN
a:=(a-128)*256+tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
IF a<10240 THEN
(*75*)
BEGIN
CASE ilk[a]OF
0:
BEGIN
curval:=a;
a:=130;
END;
1:
BEGIN
curval:=equiv[a]-32768;
a:=128;
END;
2:
BEGIN
pushlevel(a);
GOTO 20;
END;
3:
BEGIN
(*76*)
WHILE(curstate.bytefield=curstate.endfield)
AND(stackptr>0) DO poplevel;
IF(stackptr=0)OR(tokmem[curstate.bytefield]<>40)THEN
BEGIN
writeln(tty);
write(tty,'! NO PARAMETER GIVEN FOR ');
printid(a);
error;
GOTO 20;
END
(*79*)
bal:=1;
curstate.bytefield:=curstate.bytefield+1;
WHILE true DO
BEGIN
b:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
IF b=13 THEN storetwobyte(nameptr+32767)
ELSE
BEGIN
IF b>=128 THEN
BEGIN
iftokptr=maxtoks THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
b:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
END
ELSE CASE b OF
40:bal:=bal+1;
41:
BEGIN
bal:=bal-1;
IF bal=0 THEN GOTO 30;
END;
39:
REPEAT
IF tokptr=maxtoks THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
b:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
UNTIL b=39;
OTHERS:
END;
IF tokptr=maxtoks THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
END;
END;
30:;
equiv[nameptr]:=textptr;
ilk[nameptr]:=2;
IF byteptr=maxbytes THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','BYTE MEMORY',' CAPACITY EXCEEDED');
error;
quit;
END;
bytemem[byteptr]:=35;
byteptr:=byteptr+1;
IF nameptr=maxnames THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','NAME',' CAPACITY EXCEEDED');
error;
quit;
END;
nameptr:=nameptr+1;
bytestart[nameptr]:=byteptr;
IF textptr=maxtexts THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TEXT',' CAPACITY EXCEEDED');
error;
quit;
END;
textlink[textptr]:=0;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
pushlevel(a);
GOTO 20;
END;
OTHERS:
BEGIN
writeln(tty);
write(tty,'! THIS CAN''T HAPPEN (','OUTPUT',')');
error;
quit;
END
END
END
ELSE IF a<20480 THEN
(*74*)
BEGIN
a:=a-10240;
IF equiv[a]<>0 THEN pushlevel(a)
ELSE IF a<>0 THEN
BEGIN
writeln(tty);
write(tty,'! NOT PRESENT: <');
printid(a);
write(tty,'>');
error;
END;
GOTO 20;
END
ELSE
BEGIN
curval:=a-20480;
a:=129;
END;
END;
END;
IF troubleshoot THEN debughelp;
getoutput:=a;
END;
(*83*)
PROCEDURE flushbuffer;
VAR k:0..outbufsize;
BEGIN
FOR k:=1 TO breakptr DO write(chr(outbuf[k-1]));
writeln;
line:=line+1;
IF line MOD 100=0 THEN write(tty,'.');
IF breakptr<outptr THEN
BEGIN
IF outbuf[breakptr]=32 THEN breakptr:=breakptr+1;
FOR k:=breakptr TO outptr-1 DO outbuf[k-breakptr]:=outbuf[k];
END;
outptr:=outptr-breakptr;
breakptr:=0;
IF outptr>linelength THEN
BEGIN
writeln(tty);
write(tty,'! LONG LINE MUST BE TRUNCATED');
error;
outptr:=linelength;
END;
END;
(*85*)
PROCEDURE appval(v:integer);
VAR k:0..outbufsize;
BEGIN k:=outbufsize;
REPEAT
outbuf[k]:=v MOD 10;
v:=v DIV 10;
k:=k-1;
UNTIL v=0;
REPEAT
k:=k+1;
outbuf[outptr]:=outbuf[k]+48;
outptr:=outptr+1;
UNTIL k=outbufsize;
END;
(*87*)
PROCEDURE sendout(t:eightbits;v:sixteenbits);
LABEL 20;
VAR k:0..linelength;
BEGIN
(*88*)
20:
CASE outstate OF
1:IF t<>3 THEN
BEGIN
breakptr:=outptr;
IF t=2 THEN
BEGIN
outbuf[outptr]:=32;
outptr:=outptr+1;
END;
END;
2:
BEGIN
outbuf[outptr]:=44-outapp;
outptr:=outptr+1;
IF outptr>linelength THEN flushbuffer;
breakptr:=outptr;
END;
3,4:
BEGIN
(*89*)
IF outval<0 THEN
BEGIN
outbuf[outptr]:=45;
outptr:=outptr+1;
END
ELSE IF outsign>0 THEN
BEGIN
outbuf[outptr]:=outsign;
outptr:=outptr+1;
END;
appval(abs(outval));
IF outptr>linelength THEN flushbuffer;
outstate:=outstate-2;
GOTO 20;
END;
5:
(*90*)
BEGIN
IF(t=3)OR((*91*)((t=2)AND(v=3)AND(((outcontrib[1]=68)
AND(outcontrib[2]=73)AND(outcontrib[3]=86))
OR((outcontrib[1]=77) AND(outcontrib[2]=79)
AND(outcontrib[3]=68))))OR((t=0)AND((v=42)OR(v=47)))) THEN
BEGIN
(*89*)
IF outval<0 THEN
BEGIN
outbuf[outptr]:=45;
outptr:=outptr+1;
END
ELSE IF outsign>0 THEN
BEGIN
outbuf[outptr]:=outsign;
outptr:=outptr+1;
END;
appval(abs(outval));
IF outptr>linelength THEN flushbuffer;
outsign:=43;
outval:=outapp;
END
ELSE outval:=outval+outapp;
outstate:=3;
GOTO 20;
END;
0:IF t<>3 THEN breakptr:=outptr;
OTHERS:
END;
IF t<>0 THEN FOR k:=1 TO v DO
BEGIN
outbuf[outptr]:=outcontrib[k];
outptr:=outptr+1;
END
ELSE
BEGIN
outbuf[outptr]:=v;
outptr:=outptr+1;
END;
IF outptr>linelength THEN flushbuffer;
IF t>=2 THEN outstate:=1
ELSE outstate:=0
END;
(*92*)
PROCEDURE sendsign(v:integer);
BEGIN
CASE outstate OF
2,4:outapp:=outapp*v;
3:
BEGIN
outapp:=v;
outstate:=4;
END;
5:
BEGIN
outval:=outval+outapp;
outapp:=v;
outstate:=4;
END;
OTHERS:
BEGIN
breakptr:=outptr;
outapp:=v;
outstate:=2;
END
END;
END;
(*93*)
PROCEDURE sendval(v:integer);
LABEL 666,10;
BEGIN
CASE outstate OF
1:
BEGIN
(*96*)
IF(outptr=breakptr+3)OR((outptr=breakptr+4)
AND(outbuf[breakptr]=32))THEN
IF((outbuf[outptr-3]=68)AND(outbuf[outptr-2]=73)
AND(outbuf[outptr-1]=86))OR((outbuf[outptr-3]=77)
AND(outbuf[outptr-2]=79)AND(outbuf[outptr-1]=68))THEN GOTO 666;
outsign:=32;
outstate:=3;
outval:=v;
breakptr:=outptr;
END;
0:
BEGIN
(*95*)
IF(outptr=breakptr+1)AND((outbuf[breakptr]=42)
OR(outbuf[breakptr]=47))THEN GOTO 666;
outsign:=0;
outstate:=3;
outval:=v;
breakptr:=outptr;
END;
(*94*)
2:
BEGIN
outsign:=43;
outstate:=3;
outval:=outapp*v;
END;
3:
BEGIN
outstate:=5;
outapp:=v;
END;
4:
BEGIN
outstate:=5;
outapp:=outapp*v;
END;
5:
BEGIN
outval:=outval+outapp;
outapp:=v;
END;
OTHERS:GOTO 666
END;
GOTO 10;
666:
(*97*)
IF v>=0 THEN
BEGIN
IF outstate=1 THEN
BEGIN
breakptr:=outptr;
outbuf[outptr]:=32;
outptr:=outptr+1;
END;
appval(v);
IF outptr>linelength THEN flushbuffer;
outstate:=1;
END
ELSE
BEGIN
outbuf[outptr]:=40;
outptr:=outptr+1;
outbuf[outptr]:=45;
outptr:=outptr+1;
appval(-v);
outbuf[outptr]:=41;
outptr:=outptr+1;
IF outptr>linelength THEN flushbuffer;
outstate:=0;
END;
10:
END;
(*99*)
PROCEDURE sendtheoutpu;
LABEL 2,21,22;
VAR
curchar:eightbits;
k:0..linelength;
j:0..maxbytes;
n:integer;
BEGIN
WHILE stackptr>0 DO
BEGIN
curchar:=getoutput;
21:
CASE curchar OF
0:;
(*102*)
65,66,67,68,69,70,71,72,73,74,75,76,77,
78,79,80,81,82,83,84,85,86,87,88,89,90:
BEGIN
outcontrib[1]:=curchar;
sendout(2,1);
END;
97,98,99,100,101,102,103,104,105,
106,107,108,109,110,111,112,113,
114,115,116,117,118,119,120,121,122:
BEGIN
outcontrib[1]:=curchar-32;
sendout(2,1);
END;
130:
BEGIN
k:=0;
j:=bytestart[curval];
WHILE(k<maxidlength)AND(j<bytestart[curval+1])DO
BEGIN
k:=k+1;
outcontrib[k]:=bytemem[j];
j:=j+1;
IF outcontrib[k]>=97 THEN outcontrib[k]:=outcontrib[k]-32
ELSE IF outcontrib[k]=24 THEN k:=k-1;
END;
sendout(2,k);
END;
(*104*)
48,49,50,51,52,53,54,55,56,57:
BEGIN
n:=0;
REPEAT
n:=10*n+curchar-48;
curchar:=getoutput;
UNTIL(curchar>57)OR(curchar<48);
sendval(n);
k:=0;
IF curchar=101 THEN curchar:=69;
IF curchar=69 THEN GOTO 2
ELSE GOTO 21;
END;
12:
BEGIN
n:=0;
curchar:=48;
REPEAT
n:=8*n+curchar-48;
curchar:=getoutput;
UNTIL(curchar>55)OR(curchar<48);
sendval(n);
GOTO 21;
END;
128:sendval(curval);
46:
BEGIN
k:=1;
outcontrib[1]:=46;
curchar:=getoutput;
IF curchar=46 THEN
BEGIN
outcontrib[2]:=46;
sendout(1,2);
END
ELSE IF(curchar>=48)AND(curchar<=57) THEN GOTO 2
ELSE
BEGIN
sendout(0,46);
GOTO 21;
END;
END;
43,45:sendsign(44-curchar);
(*100*)
4:
BEGIN
outcontrib[1]:=65;
outcontrib[2]:=78;
outcontrib[3]:=68;
sendout(2,3);
END;
5:
BEGIN
outcontrib[1]:=78;
outcontrib[2]:=79;
outcontrib[3]:=84;
sendout(2,3);
END;
6:
BEGIN
outcontrib[1]:=73;
outcontrib[2]:=78;
sendout(2,2);
END;
31:
BEGIN
outcontrib[1]:=79;
outcontrib[2]:=82;
sendout(2,2);
END;
95:
BEGIN
outcontrib[1]:=58;
outcontrib[2]:=61;
sendout(1,2);
END;
27:
BEGIN
outcontrib[1]:=60;
outcontrib[2]:=62;
sendout(1,2);
END;
28:
BEGIN
outcontrib[1]:=60;
outcontrib[2]:=61;
sendout(1,2);
END;
29:
BEGIN
outcontrib[1]:=62;
outcontrib[2]:=61;
sendout(1,2);
END;
30:
BEGIN
outcontrib[1]:=61;
outcontrib[2]:=61;
sendout(1,2);
END;
32:
BEGIN
outcontrib[1]:=46;
outcontrib[2]:=46;
sendout(1,2);
END;
39:
(*103*)
BEGIN
k:=1;
outcontrib[1]:=39;
REPEAT
IF k<linelength THEN k:=k+1;
outcontrib[k]:=getoutput;
UNTIL(outcontrib[k]=39)OR(stackptr=0);
IF k=linelength THEN
BEGIN
writeln(tty);
write(tty,'! STRING TOO LONG');
error;
END;
sendout(1,k);
curchar:=getoutput;
IF curchar=39 THEN outstate:=6;
GOTO 21;
END;
(*101*)
33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,
63,64,91,92,93,94,24,96,123,124,126:sendout(0,curchar);
(*106*)
9:
BEGIN
IF bracelevel=0 THEN sendout(0,123)
ELSE sendout(0,91);
bracelevel:=bracelevel+1;
END;
10:IF bracelevel>0 THEN
BEGIN
bracelevel:=bracelevel-1;
IF bracelevel=0 THEN sendout(0,126)
ELSE sendout(0,93);
END
ELSE
BEGIN
writeln(tty);
write(tty,'! EXTRA @*)');
error;
END;
129:IF bracelevel=0 THEN
BEGIN
sendout(0,123);
sendval(curval);
sendout(0,126);
END
ELSE
BEGIN
sendout(0,91);
sendval(curval);
sendout(0,93);
END;
127:
BEGIN
sendout(3,0);
outstate:=6;
END;
OTHERS:
BEGIN
writeln(tty);
write(tty,'! CAN''T OUTPUT ASCII CODE ',curchar:0);
error;
END
END;
GOTO 22;
2:
(*105*)
REPEAT
IF k<linelength THEN k:=k+1;
outcontrib[k]:=curchar;
curchar:=getoutput;
IF(outcontrib[k]=69)AND((curchar=43)OR(curchar=45))THEN
BEGIN
IF k<linelength THEN k:=k+1;
outcontrib[k]:=curchar;
curchar:=getoutput;
END
ELSE IF curchar=101 THEN curchar:=69;
UNTIL(curchar<>69)AND((curchar<48)OR(curchar>57));
IF k=linelength THEN
BEGIN
writeln(tty);
write(tty,'! FRACTION TOO LONG');
error;
END;
sendout(3,k);
GOTO 21;
22:
END;
END;
(*110*)
PROCEDURE getline;
BEGIN
IF buffer[0]=12 THEN line:=0;
IF inputln THEN
BEGIN
IF line=0 THEN
BEGIN
page:=page+1;
write(tty,page:0,' ');
(*111*)
IF(page=1)AND(limit=29)THEN
IF(buffer[0]=67)AND(buffer[8]=22) THEN
REPEAT
IF inputln THEN
ELSE
BEGIN
limit:=0;
buffer[0]:=12;
END;
UNTIL buffer[0]=12;
END;
IF buffer[limit]=13 THEN buffer[limit]:=32;
END
ELSE IF buffer[0]<>12 THEN
BEGIN
limit:=0;
buffer[0]:=12;
END
ELSE inputhasende:=true;
line:=line+1;
loc:=0;
END;
(*112*)
FUNCTION controlcode(c:asciicode):eightbits;
BEGIN
CASE c OF
64:controlcode:=64;
39:controlcode:=12;
32,9,42:controlcode:=137;
84,116:controlcode:=131;
68,100:controlcode:=133;
70,102:controlcode:=132;
123:controlcode:=9;
126:controlcode:=10;
80,112:controlcode:=134;
38:controlcode:=127;
60:controlcode:=135;
OTHERS:controlcode:=0
END;
END;
(*113*)
FUNCTION skipahead:eightbits;
LABEL 30;
VAR c:eightbits;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
getline;
IF buffer[0]=12 THEN
BEGIN
loc:=1;
c:=136;
GOTO 30;
END;
END;
buffer[limit+1]:=64;
WHILE buffer[loc]<>64 DO loc:=loc+1;
IF loc<=limit THEN
BEGIN
loc:=loc+2;
c:=controlcode(buffer[loc-1]);
IF(c<>0)OR(buffer[loc-1]=62)THEN GOTO 30;
END;
END;
30:
skipahead:=c;
END;
(*114*)
PROCEDURE skipcomment;
LABEL 10;
VAR
bal:eightbits;
c:asciicode;
BEGIN
bal:=0;
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
getline;
IF buffer[0]=12 THEN
BEGIN
writeln(tty);
write(tty,'! PAGE ENDED IN MID-COMMENT');
error;
loc:=1;
GOTO 10;
END;
END;
c:=buffer[loc];
loc:=loc+1;
(*115*)
IF c=64 THEN
BEGIN
c:=buffer[loc];
IF(c<>32)AND(c<>9) AND(c<>42)THEN loc:=loc+1
ELSE
BEGIN
writeln(tty);
write(tty,'! MODULE ENDED IN MID-COMMENT');
error;
loc:=loc-1;
GOTO 10;
END
END
ELSE IF(c=92)AND(buffer[loc]<>64)THEN loc:=loc+1
ELSE IF c=123 THEN bal:=bal+1
ELSE IF c=126 THEN
BEGIN
IF bal=0 THEN GOTO 10;
bal:=bal-1;
END;
END;
10:
END;
(*117*)
FUNCTION getnext:eightbits;
LABEL 20,30;
VAR
c:eightbits;
d:eightbits;
j,k:0..longestname;
BEGIN
20:
IF loc>limit THEN getline;
c:=buffer[loc];
loc:=loc+1;
CASE c OF
65,66,67,68,69,70,71,72,73,74,75,76,77,
78,79,80,81,82,83,84,85,86,87,88,89,90,
97,98,99,100,101,102,103,104,105,106,107,
108,109,110,111,112,113,114,115,116,117,
118,119,120,121,122:
(*119*)
BEGIN
loc:=loc-1;
idfirst:=loc;
REPEAT
loc:=loc+1;
d:=buffer[loc];
UNTIL((d<48)OR((d>57)AND(d<65))
OR((d>90)AND(d<97))OR(d>122))AND(d<>24);
IF loc>idfirst+1 THEN
BEGIN
c:=130;
idloc:=loc;
END;
END;
34:
(*120*)
BEGIN
doublechars:=0;
idfirst:=loc-1;
REPEAT
d:=buffer[loc];
loc:=loc+1;
IF(d=34)OR(d=64)THEN
IF buffer[loc]=d THEN
BEGIN
loc:=loc+1;
d:=0;
doublechars:=doublechars+1;
END
ELSE IF d=64 THEN
BEGIN
writeln(tty);
write(tty,'! DOUBLE @ SIGN MISSING');
error;
END
ELSE IF loc>limit THEN
BEGIN
writeln(tty);
write(tty,'! STRING CONSTANT DIDN''T END');
error;
d:=34;
END;
UNTIL d=34;
idloc:=loc-1;
c:=130;
END;
64:
(*121*)
BEGIN
c:=controlcode(buffer[loc]);
loc:=loc+1;
IF c=0 THEN GOTO 20
ELSE IF c=135 THEN
(*122*)
BEGIN
(*124*)
k:=0;
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
getline;
IF buffer[0]=12 THEN
BEGIN
writeln(tty);
write(tty,'! PAGE ENDED IN MODULE NAME');
error;
loc:=1;
GOTO 30;
END;
END;
d:=buffer[loc];
(*125*)
IF d=64 THEN
BEGIN
d:=buffer[loc+1];
IF d=62 THEN
BEGIN
loc:=loc+2;
GOTO 30;
END;
IF(d=32)OR(d=9)OR(d=42) THEN
BEGIN
writeln(tty);
write(tty,'! MODULE NAME DIDN''T END');
error;
GOTO 30;
END;
k:=k+1;
module[k]:=64;
loc:=loc+1;
END;
loc:=loc+1;
IF k<
longestname-1 THEN k:=k+1;
IF(d=32)OR(d=9)THEN
BEGIN
d:=32;
IF module[k-1]=32 THEN k:=k-1;
END;
module[k]:=d;
END;
30:
(*126*)
IF k>=longestname-2 THEN
BEGIN
writeln(tty);
write(tty,'! MODULE NAME TOO LONG: ');
FOR j:=1 TO 25 DO write(tty,chr(module[j]));
write(tty,'...');
END;
IF(module[k]=32)AND(k>0)THEN k:=k-1;
IF k>3 THEN
BEGIN
IF(module[k]=46)AND(module[k-1]=46)
AND(module[k-2]=46)THEN curmodule:=prefixlookup(k-3)
ELSE curmodule:=modlookup(k);
END
ELSE curmodule:=modlookup(k);
END
ELSE IF c=131 THEN
BEGIN
REPEAT c:=skipahead;
UNTIL c<>64;
IF buffer[loc-1]<>62 THEN
BEGIN
writeln(tty);
write(tty,'! IMPROPER @ WITHIN @T...@>');
error;
END;
GOTO 20;
END;
END;
(*118*)
46:IF buffer[loc]=46 THEN
BEGIN
c:=32;
loc:=loc+1;
END;
58:IF buffer[loc]=61 THEN
BEGIN
c:=95;
loc:=loc+1;
END;
61:IF buffer[loc]=61 THEN
BEGIN
c:=30;
loc:=loc+1;
END;
62:IF buffer[loc]=61 THEN
BEGIN
c:=29;
loc:=
loc+1;
END;
60:IF buffer[loc]=61 THEN
BEGIN
c:=28;
loc:=loc+1;
END
ELSE IF buffer[loc]=62 THEN
BEGIN
c:=27;
loc:=loc+1;
END;
40:IF buffer[loc]=42 THEN
BEGIN
c:=9;
loc:=loc+1;
END;
42:IF buffer[loc]=41 THEN
BEGIN
c:=10;
loc:=loc+1;
END;
32,9:GOTO 20;
123:
BEGIN
skipcomment;
GOTO 20;
END;
12:c:=136;
OTHERS:
END;
IF troubleshoot THEN debughelp;
getnext:=c;
END;
(*128*)
PROCEDURE scannumeric(p:namepointer);
LABEL 21,30;
VAR
accumulator:integer;
nextsign:-1..+1;
q:namepointer;
val:integer;
PROCEDURE addin(v:integer);
BEGIN accumulator:=accumulator+nextsign*v;
nextsign:=+1;
END;
BEGIN
(*129*)
accumulator:=0;
nextsign:=+1;
WHILE true DO BEGIN nextcontrol:=getnext;
21:
CASE nextcontrol OF
48,49,50,51,52,53,54,55,56,57:
BEGIN
(*131*)
val:=0;
REPEAT
val:=10*val+nextcontrol-48;
nextcontrol:=getnext;
UNTIL(nextcontrol>57)OR(nextcontrol<48);
addin(val);
GOTO 21;
END;
12:
BEGIN
(*132*)
val:=0;
nextcontrol:=48;
REPEAT val:=8*val+nextcontrol-48;
nextcontrol:=getnext;
UNTIL(nextcontrol>55)OR(nextcontrol<48);
addin(val);
GOTO 21;
END;
130:
BEGIN
q:=idlookup(0);
IF ilk[q]<>1 THEN
BEGIN
nextcontrol:=42;
GOTO 21;
END;
addin(equiv[q]-32768);
END;
43:;
45:nextsign:=-nextsign;
132,133,135,134,136,137:GOTO 30;
59:
BEGIN
writeln(tty);
write(tty,'! OMIT SEMICOLON IN NUMERIC DEFINITION');
error;
END;
OTHERS:
(*130*)
BEGIN
writeln(tty);
write(tty,'! IMPROPER NUMERIC DEFINITION WILL BE FLUSHED');
error;
REPEAT nextcontrol:=skipahead
UNTIL(nextcontrol>=132);
IF nextcontrol=135 THEN
BEGIN
loc:=loc-2;
nextcontrol:=getnext;
END;
accumulator:=0;
GOTO 30;
END
END;
END;
30:;
IF abs(accumulator)>=32768 THEN
BEGIN writeln(tty);
write(tty,'! VALUE TOO BIG: ',accumulator:0);
error;
accumulator:=0;
END;
equiv[p]:=accumulator+32768;
END;
(*135*)
PROCEDURE scanrepl(t:eightbits);
LABEL 22,30,31;
VAR
a:sixteenbits;
b:asciicode;
bal:eightbits;
BEGIN
bal:=0;
WHILE true DO
BEGIN
22:
a:=getnext;
CASE a OF
40:bal:=bal+1;
41:IF bal=0 THEN
BEGIN
writeln(tty);
write(tty,'! EXTRA )');
error;
END
ELSE bal:=bal-1;
39:
(*138*)
BEGIN
b:=39;
WHILE true DO
BEGIN
IF tokptr=maxtoks THEN BEGIN writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
IF b=64 THEN
IF buffer[loc]=64 THEN loc:=loc+1
ELSE
BEGIN
writeln(tty);
write(tty,'! YOU SHOULD DOUBLE @ SIGNS IN STRINGS');
error;
END;
IF loc=limit THEN
BEGIN
writeln(tty);
write(tty,'! STRING DIDN''T END');
error;
buffer[loc]:=39;
buffer[loc+1]:=0;
END;
b:=buffer[loc];
loc:=loc+1;
IF b=39
THEN
BEGIN
IF buffer[loc]<>39 THEN GOTO 31
ELSE
BEGIN
loc:=loc+1;
IF tokptr=maxtoks THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=39;
tokptr:=tokptr+1;
END;
END;
END;
31:
END;
35:IF t=3 THEN a:=13;
(*137*)
130:
BEGIN
a:=idlookup(0);
IF tokptr=maxtoks THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=(a DIV 256)+128;
tokptr:=tokptr+1;
a:=a MOD 256;
END;
135:IF t<>135 THEN GOTO 30
ELSE
BEGIN
IF tokptr=maxtoks THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=(curmodule DIV 256)+168;
tokptr:=tokptr+1;
a:=curmodule MOD 256;
END;
133,132,134:IF t<>135 THEN GOTO 30
ELSE
BEGIN
writeln(tty);
write(tty,'! @',chr(buffer[loc-1]),' IS IGNORED IN PASCAL TEXT');
error;
GOTO 22;
END;
136,137:GOTO 30;
OTHERS:
END;
IF tokptr=maxtoks THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=a;
tokptr:=tokptr+1;
END;
30:
nextcontrol:=a;
(*136*)
IF bal>0 THEN
BEGIN
writeln(tty);
write(tty,'! MISSING ',bal:0,' )');
error;
WHILE bal>0 DO
BEGIN
IF tokptr=maxtoks THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TOKEN',' CAPACITY EXCEEDED');
error;
quit;
END;
tokmem[tokptr]:=41;
tokptr:=tokptr+1;
bal:=bal-1;
END;
END;
IF textptr=maxtexts THEN
BEGIN
writeln(tty);
write(tty,'! SORRY, ','TEXT',' CAPACITY EXCEEDED');
error;
quit;
END;
currepltext:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
(*139*)
PROCEDURE definemacro(t:eightbits);
VAR p:namepointer;
BEGIN
p:=idlookup(t);
scanrepl(t);
equiv[p]:=currepltext;
textlink[currepltext]:=0;
END;
(*141*)
PROCEDURE scanmodule;
LABEL 30,10;
VAR p:namepointer;
BEGIN
modulecount:=modulecount+1;
(*142*)
nextcontrol:=0;
WHILE true DO
BEGIN
22:
WHILE nextcontrol<=132 DO
BEGIN
nextcontrol:=skipahead;
IF nextcontrol=135 THEN
BEGIN
loc:=loc-2;
nextcontrol:=getnext;
END;
END;
IF nextcontrol<>133 THEN
GOTO 30;
nextcontrol:=getnext;
IF nextcontrol<>130 THEN
BEGIN
writeln(tty);
write(tty,'! DEFINITION FLUSHED, MUST START WITH ',
'IDENTIFIER OF LENGTH > 1');
error;
GOTO 22;
END;
nextcontrol:=getnext;
IF nextcontrol=61 THEN
BEGIN
scannumeric(idlookup(1));
GOTO 22;
END
ELSE IF nextcontrol=30 THEN
BEGIN
definemacro(2);
GOTO 22;
END
ELSE
(*143*)
IF nextcontrol=40 THEN
BEGIN
nextcontrol:=getnext;
IF nextcontrol=35 THEN
BEGIN
nextcontrol:=getnext;
IF nextcontrol=41 THEN
BEGIN
nextcontrol:=getnext;
IF nextcontrol=61 THEN
BEGIN
writeln(tty);
write(tty,'! USE == FOR MACROS');
error;
nextcontrol:=30;
END;
IF nextcontrol=30 THEN
BEGIN
definemacro(3);
GOTO 22;
END;
END;
END;
END;
writeln(tty);
write(tty,'! DEFINITION FLUSHED SINCE IT STARTS BADLY');
error;
END;
30:;
(*144*)
CASE nextcontrol OF
134:p:=0;
135:
BEGIN
p:=curmodule;
(*145*)
REPEAT
nextcontrol:=getnext;
UNTIL nextcontrol<>43;
IF(nextcontrol<>61)AND(nextcontrol<>30) THEN
BEGIN
writeln(tty);
write(tty,'! PASCAL TEXT FLUSHED, = SIGN IS MISSING');
error;
REPEAT
nextcontrol:=skipahead;
UNTIL nextcontrol>=136;
GOTO 10;
END;
END;
OTHERS:GOTO 10
END;
(*146*)
storetwobyte(53248+modulecount);
scanrepl(135);
(*147*)
IF p=0 THEN
BEGIN
textlink[lastunnamed]:=currepltext;
lastunnamed:=currepltext;
END
ELSE IF equiv[p]=0 THEN equiv[p]:=currepltext
ELSE
BEGIN
p:=equiv[p];
WHILE textlink[p]<maxtexts DO p:=textlink[p];
textlink[p]:=currepltext;
END;
textlink[currepltext]:=maxtexts;
10:
END;
(*150*)
PROCEDURE debughelp;
LABEL 888;
VAR k:sixteenbits;
BEGIN
WHILE ddt<>0 DO
BEGIN
888:
CASE ddt OF
0:;
1:printid(dd);
2:printrepl(dd);
3:
BEGIN
writeln(tty);
write(tty,'*');
error;
END;
4:FOR k:=1 TO dd DO write(tty,chr(module[k]));
5:FOR k:=1 TO dd DO write(tty,chr(outcontrib[k]));
OTHERS:
BEGIN
write(tty,'?');
read(tty,ddt);
END
END;
END;
END;
BEGIN
initialize;
(*109*)
IF openinput THEN
BEGIN
writeln(tty);
write(tty,'! COULDN''T OPEN THE INPUT FILE.');
quit;
END;
page:=0;
line:=0;
limit:=0;
loc:=1;
buffer[0]:=32;
inputhasende:=false;
(*152*)
phaseone:=true;
modulecount:=0;
REPEAT
nextcontrol:=skipahead;
WHILE nextcontrol=137 DO scanmodule;
UNTIL inputhasende;
phaseone:=false;
maxtokptr:=tokptr;
(*98*)
IF textlink[0]=0 THEN
BEGIN
writeln(tty);
write(tty,'! NO OUTPUT WAS SPECIFIED.');
END
ELSE
BEGIN
writeln(tty);
write(tty,'WRITING THE OUTPUT FILE...');
(*69*)
stackptr:=1;
bracelevel:=0;
curstate.namefield:=0;
curstate.replfield:=textlink[0];
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+1];
(*82*)
outstate:=0;
outptr:=0;
breakptr:=0;
outbuf[0]:=0;
line:=1;
sendtheoutpu;
(*84*)
IF(outstate<>0)OR(outbuf[breakptr]<>46)THEN
BEGIN
writeln(tty);
write(tty,'! PROGRAM DIDN''T END WITH PERIOD');
error;
END;
breakptr:=outptr;
flushbuffer;
writeln(tty);
write(tty,'DONE.');
END;
9999:
IF stringptr>128 THEN
BEGIN
writeln(tty);
write(tty,stringptr-128:0,' STRINGS WRITTEN TO STRING POOL FILE.');
END;
(*153*)
writeln(tty);
write(tty,'MEMORY USAGE STATISTICS:');
writeln(tty);
write(tty,nameptr:0,' NAMES, ',textptr:0,' REPLACEMENT TEXTS;');
writeln(tty);
write(tty,byteptr:0,' BYTES, ',maxtokptr:0,' TOKENS.');
END.